home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / DOORKIT3.PAS < prev    next >
Pascal/Delphi Source File  |  1997-08-14  |  53KB  |  1,516 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....
  13.  
  14.    This is the "Artsy-Fartsy" unit. These procedures and functions are for
  15.    ANSI display purposes and door enhancement.}
  16.  
  17. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  18. UNIT DOORKIT3;
  19.  
  20. INTERFACE
  21.  
  22. USES _EXIT;
  23.  
  24. {─--[Headers]-──────────────────────────────────────────────────────────────}
  25.  
  26. PROCEDURE ShowProgramAd;
  27. {^ This will clear the screen and display a banner teliing the name and
  28.    description of your program. You will most likely want to customize
  29.    this before you write any doors with this kit.}
  30. PROCEDURE CPrompt(HotKey : CHAR ; Txt : STRING);
  31. {^ Simply draws text on the screen like most BBSes use in the selections in
  32.    their file listings and message readers. (ie: [S]election). Keeping the
  33.    HotKey and Txt separate is faster than using Copy/Delete on a string.}
  34. PROCEDURE MenuKey(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  35. {^ Just like CPrompt except this draws the prompt at X/Y coordinates on the
  36.    screen. ANSI must be enabled for this to work.}
  37. PROCEDURE YesNoBox;
  38. {^ Simply draws a colored [Y/N] on the screen.}
  39. PROCEDURE FancyPrompt;
  40. {^ Displays a fancy "Your Selection:" on the screen.}
  41. PROCEDURE Select;
  42. {^ Displays a fancy "Select:" on the screen.}
  43. PROCEDURE YnPrompt(Txt : STRING);
  44. {^ Prints your "Txt" on the screen followed by a colored [Y/n].}
  45. PROCEDURE NyPrompt(Txt : STRING);
  46. {^ Prints your "Txt" on the screen followed by a colored [y/N].}
  47. PROCEDURE AnyKey;
  48. {^ Displays a nice "Press Any Key To Continue" prompt and waits for keypress.}
  49. PROCEDURE OutTxt(FG,BG : BYTE ; Txt : STRING);
  50. {^ Special procedure. Prints text on both screens in the colors
  51.    specified by the FG and BG variables. If the user does not have
  52.    ANSI enabled, then no color codes are sent.}
  53. PROCEDURE OutTxtL(FG,BG : BYTE ; Txt : STRING);
  54. {^ Same as above except a line feed is sent after the text.}
  55. PROCEDURE OutTxtXY(X,Y,FG,BG : BYTE ; Txt : STRING);
  56. {^ Special procedure. Prints text on both screens at X/Y coordinates
  57.    in the colors specified by the FG and BG variables. This procedure
  58.    requires the user to have ANSI enabled!}
  59. PROCEDURE OutTxtXYL(X,Y,FG,BG : BYTE ; Txt : STRING);
  60. {^ Same as above except a line feed is sent after the text.}
  61. PROCEDURE LineBar(FG,BG,L : BYTE);
  62. {^ Draws a thin line across the screen in FG/BG colors at L length.}
  63. FUNCTION SecretInput(Len : BYTE; Default : STRING) : STRING;
  64. {^ Special procedure. Creates an input field for getting passwords.
  65.    the result of all input is hidden from the user's view.}
  66. FUNCTION NameInput(Len : BYTE; Default : STRING) : STRING;
  67. {^ Special procedure. Creates an input field that will automatically
  68.    force all input to proper case.}
  69. FUNCTION NormalInput(Len : BYTE; Default : STRING) : STRING;
  70. {^ Special procedure. Creates an input field, all characters accepted}
  71. FUNCTION CapsInput(Len : BYTE; Default : STRING) : STRING;
  72. {^ Special procedure. Creates an input field that will automatically
  73.    force all input to upper case letters}
  74. FUNCTION NumberInput(Len : BYTE; Default : STRING) : STRING;
  75. {^ Special procedure. Creates an input field but will only allow the
  76.    input of numeric characters}
  77. FUNCTION NamePrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  78. {^ Similar to NameInput except the user is required to have ANSI
  79.    enabled. This will produce an input field on the screen filled
  80.    with underscores and will have a bracket on both ends.}
  81. FUNCTION NormalPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  82. {^ Similar to NormalInput but follows the same rules as NamePrompt.}
  83. FUNCTION NumberPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  84. {^ Similar to NumberInput but follows the same rules as NamePrompt.}
  85. FUNCTION SecretPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  86. {^ Similar to SecretInput but follows the same rules as NamePrompt.}
  87. FUNCTION CapsPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  88. {^ Similar to CapsInput but follows the same rules as NameIprompt.}
  89. FUNCTION SysField(X,Y,Style,StrLength : BYTE ; InStr : STRING) : STRING;
  90. {^ Special procedure. Say for example you wanted to create a feature in
  91.    your door where you have various input fields at specific locations.
  92.    You would use this to draw a fields on the screen. Then you would use
  93.    it in conjunction with the next procedure to make it look like your
  94.    fields are shifting and showing the field that is active. ANSI must
  95.    be enabled. (Style = 0-Normal 1-Number 2-Name 3-Secret 4-Caps)}
  96. PROCEDURE DummyField(X,Y,StrLength : BYTE ; InStr : STRING);
  97. {^ See the above description.}
  98. PROCEDURE DrawWin(X1,Y1,X2,Y2 : BYTE ; Title : STRING);
  99. {^ Draws a window on both screens at X1,Y1,X2,Y2 coordinates with a title.
  100.    ANSI graphics required for this.'}
  101. PROCEDURE ClearWin(X1,Y1,X2,Y2 : BYTE);
  102. {^ Clears a window with the CS.Wbg color, ANSI graphics required for this.}
  103. PROCEDURE DrawButton(HotKey : CHAR ; Txt : STRING ; HighLight : BOOLEAN);
  104. {^ Draws a simulated raised button on the screen.}
  105. PROCEDURE SysButton(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  106. {^ Draws a simulated raised button on the screen at X/Y coorinates. This is
  107.    mainly meant to be used with DrawWin since the button uses the window
  108.    background color on its edges. ANSI is required for this.}
  109. PROCEDURE DrawMenu(X1,Y1,X2,Y2 : BYTE);
  110. {^ Creates a simulated drop down menu at X1,Y1,X2,Y2, ANSI required.}
  111. PROCEDURE MenuItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  112. {^ Adds a selection to a drop down menu, ANSI required.}
  113. PROCEDURE MenuLine(X,Y,L : BYTE);
  114. {^ Adds a dividing line to a drop down menu, ANSI required.}
  115. PROCEDURE MenuBarItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  116. {^ Since you are making simulated drop down menus, they have to drop down
  117.    from a menu bar. Most times a menu bar is nothing more than going to the
  118.    1,1 coordinate and doing an sClrEol. After that, you will add items to
  119.    your menu bar. ANSI required.}
  120. PROCEDURE InfoBox(Width : BYTE ; Height : BYTE);
  121. {^ Creates a nice 3D frame on the screen, ANSI required.}
  122. PROCEDURE InfoText(Txt : STRING);
  123. {^ Creates a nice banner on the screen just like AnyKey does.}
  124. PROCEDURE RunEntryForm(ScriptFile : STRING);
  125. {^ Runs a Dynamic Entry Form (ie: Script).}
  126. PROCEDURE CvtColors(InStr : STRING ; LF : BOOLEAN);
  127. {^ Displays a text string with embedded "Fancy Bracket" color codes and
  128.    automatically changes color of the text is displayed. (If LF is true,
  129.    a linefeed will be sent).}
  130. FUNCTION StripColors(InStr : STRING) : STRING;
  131. {^ Similar to CvtColors except this one strips color codes.}
  132. PROCEDURE RipToText;
  133. {^ If a caller is connected in RIP graphics mode, you must make a call to
  134.    this procedure to throw RIPterm back into text mode. To throw RIPterm
  135.    back into RIP graphics mode, simply use ShowScreen() to display a *.RIP}
  136. PROCEDURE ShowTextFile(TextFile : STRING);
  137. {^ This displays a text file to the user in the "Text Reader" where they
  138.    can use [P]revious, [M]ore, [T]op, [B]ottom and [Q]uit keys.}
  139. PROCEDURE ShowScreen(Scr : STRING);
  140. {^ This is a non-stop display of an ANSI/ASCII/RIP/MAX screen file where
  141.    each line is checked for global system variables and translated.}
  142. PROCEDURE IceText(S : STRING ; LF : BOOLEAN);
  143. {^ Prints a text string on the screen similar to how "Ice" products do.}
  144. PROCEDURE nstText(S : STRING ; LF : BOOLEAN);
  145. {^ Prints a text string on the screen similar to how nstSoft products do.}
  146. PROCEDURE ChatSelect;
  147. {^ This procedure can be called from any other procedure to throw the door
  148.    into SysOp/User chat. Depending on the user's graphics capabilities, the
  149.    door will decide which chat mode to use. There are split screen chat and
  150.    line chat chat modes. Line chat mode will only be used in the event the
  151.    caller only has TTY graphics capabilities.}
  152. PROCEDURE DVWrite(X,Y : WORD; Attr : BYTE; S : STRING);
  153. {^ No this doesn't have anything to do with DesqView. This means Direct Video
  154.    Write. This allows you to display something on the local screen without it
  155.    ever affecting the user's video. You can change colors, move the cursor to
  156.    specific X/Y coordinates, you name it, and there is never any effect on the
  157.    user's screen. That's just an advantage of writing directly to the video
  158.    RAM rather than going through the BIOS.}
  159. PROCEDURE AlertTones;
  160. {^ Produces five ^G tones with a 200ms delay between tones. Use this to alert
  161.    the user of an error. The sysop will only hear the tones if the door is
  162.    running locally, otherwise the tones are sent straight to the comport.}
  163.  
  164. IMPLEMENTATION
  165.  
  166. USES CRT, TDK_VARS, ANSIUNIT, DOORKIT1, DOORKIT2;
  167.  
  168. {───────────────────────────────────────────────────────────────────────────}
  169. PROCEDURE ShowProgramAd;
  170. BEGIN
  171.   TextAttr := 7;
  172.   sClrScr;
  173.   LineBar(1,0,79);
  174.   IceText(ProgramName,TRUE);
  175.   IceText(ProgramDesc,TRUE);
  176.   IceText(Copyright,TRUE);
  177.   LineBar(1,0,79);
  178. END;
  179. {───────────────────────────────────────────────────────────────────────────}
  180. PROCEDURE CPrompt(HotKey : CHAR ; Txt : STRING);
  181. BEGIN
  182.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('[');
  183.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC(HotKey);
  184.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC(']');
  185.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt + ' ');
  186. END;
  187. {───────────────────────────────────────────────────────────────────────────}
  188. PROCEDURE MenuKey(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  189. BEGIN
  190.   sGotoXY(X,Y);
  191.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('[');
  192.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC(HotKey);
  193.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC(']');
  194.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  195. END;
  196. {───────────────────────────────────────────────────────────────────────────}
  197. PROCEDURE YesNoBox;
  198. BEGIN
  199.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  200.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('Y');
  201.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  202.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('N');
  203.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  204. END;
  205. {───────────────────────────────────────────────────────────────────────────}
  206. PROCEDURE FancyPrompt;
  207. BEGIN
  208.   OutTxt(9,0,'Y');
  209.   OutTxt(11,0,'o');
  210.   OutTxt(15,0,'ur Selecti');
  211.   OutTxt(11,0,'o');
  212.   OutTxt(9,0,'n');
  213.   OutTxt(8,0,': ');
  214. END;
  215. {───────────────────────────────────────────────────────────────────────────}
  216. PROCEDURE Select;
  217. BEGIN
  218.   OutTxt(9,0,'S');
  219.   OutTxt(11,0,'e');
  220.   OutTxt(15,0,'le');
  221.   OutTxt(11,0,'c');
  222.   OutTxt(9,0,'t');
  223.   OutTxt(8,0,':');
  224. END;
  225. {───────────────────────────────────────────────────────────────────────────}
  226. PROCEDURE YnPrompt(Txt : STRING);
  227. BEGIN
  228.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  229.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  230.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('Y');
  231.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  232.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('n');
  233.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  234. END;
  235. {───────────────────────────────────────────────────────────────────────────}
  236. PROCEDURE NyPrompt(Txt : STRING);
  237. BEGIN
  238.   Set_Color(CS.CPTfg,CS.CPTbg); sWrite(Txt);
  239.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite(' [');
  240.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('N');
  241.   Set_Color(CS.CPBfg,CS.CPBbg); sWriteC('/');
  242.   Set_Color(CS.CPKfg,CS.CPKbg); sWriteC('y');
  243.   Set_Color(CS.CPBfg,CS.CPBbg); sWrite('] ');
  244. END;
  245. {───────────────────────────────────────────────────────────────────────────}
  246. PROCEDURE AnyKey;
  247. BEGIN
  248.   Set_Color(1,0);  sWrite('░▒▓');
  249.   Set_Color(15,1); sWrite(' Press Any Key To Continue ');
  250.   Set_Color(1,0);  sWrite('▓▒░');
  251.   sReadKey;
  252. END;
  253. {───────────────────────────────────────────────────────────────────────────}
  254. PROCEDURE OutTxt(FG,BG : BYTE ; Txt : STRING);
  255. BEGIN
  256.   Set_Color(FG,BG);
  257.   sWrite(Txt);
  258. END;
  259. {───────────────────────────────────────────────────────────────────────────}
  260. PROCEDURE OutTxtL(FG,BG : BYTE ; Txt : STRING);
  261. BEGIN
  262.   Set_Color(FG,BG);
  263.   sWriteln(Txt);
  264. END;
  265. {───────────────────────────────────────────────────────────────────────────}
  266. PROCEDURE OutTxtXY(X,Y,FG,BG : BYTE ; Txt : STRING);
  267. BEGIN
  268.   sGotoXY(X,Y);
  269.   Set_Color(FG,BG);
  270.   sWrite(Txt);
  271. END;
  272. {───────────────────────────────────────────────────────────────────────────}
  273. PROCEDURE OutTxtXYL(X,Y,FG,BG : BYTE ; Txt : STRING);
  274. BEGIN
  275.   sGotoXY(X,Y);
  276.   Set_Color(FG,BG);
  277.   sWriteln(Txt);
  278. END;
  279. {───────────────────────────────────────────────────────────────────────────}
  280. PROCEDURE LineBar(FG,BG,L : BYTE);
  281. VAR
  282.   Loop : BYTE;
  283.   S    : STRING[80];
  284. BEGIN
  285.   Set_Color(FG,BG);
  286.   S := '';
  287.   FOR Loop := 1 TO L DO S := S + '─';
  288.   sWriteln(S);
  289. END;
  290. {───────────────────────────────────────────────────────────────────────────}
  291. FUNCTION InputDriver(Len : BYTE; Name,Showit,AllCap,NumInput : BOOLEAN; tLine : STRING) : STRING;
  292. VAR
  293.   Ch      : CHAR;
  294.   Insrt   : BOOLEAN;
  295.   Loop,
  296.   J,Place : BYTE;
  297.   Temp,
  298.   RTemp   : STRING;
  299. BEGIN
  300.   Insrt := TRUE;
  301.   IF tLine = '' THEN Place := 1 ELSE Place := LENGTH(tLine) + 1;
  302.   IF (Graphics = TTY) AND (tLine <> '') THEN sWrite(tLine);
  303.   REPEAT
  304.     Ch := sReadKey;
  305.     IF Name THEN BEGIN
  306.       IF Place = 1 THEN Ch := UPCASE(Ch) ELSE IF tLine[Place - 1] = #32 THEN Ch := UPCASE(Ch);
  307.     END;
  308.     IF AllCap THEN Ch := UPCASE(Ch);
  309.     IF (NumInput AND (Ch IN [#0..#31,'0'..'9','-','+','/','*'])) OR NOT NumInput THEN
  310.     CASE Ch OF
  311.       #0,
  312.       #22,
  313.       #27,
  314.       #127 : BEGIN
  315.              Temp := Ch;
  316.              IF Ch = #0  THEN Temp := s_ReadKey;
  317.              IF Ch = #27 THEN Temp := Temp + sReadKey + sReadKey;
  318.              IF Ch = #22 THEN BEGIN
  319.                sWaitInput(250);
  320.                IF sKeyPressed THEN Temp := Temp + sReadKey;
  321.              END;
  322.              J := 0;
  323.              REPEAT
  324.                IF Temp = CursorMove.Home[J] THEN BEGIN
  325.                  IF Place - 1 <> 0 THEN sCursorLeft(Place - 1);
  326.                  Place := 1;
  327.                  Temp  := '';
  328.                END ELSE IF Temp = CursorMove.EndKey[J] THEN BEGIN
  329.                  IF LENGTH(tLine) - Place + 1 <> 0 THEN sCursorRight(LENGTH(tLine) - Place + 1);
  330.                  Place := BYTE(tLine[0]) + 1;
  331.                  Temp  := '';
  332.                END ELSE IF Temp = CursorMove.Left[J] THEN BEGIN
  333.                  IF Place <> 1 THEN BEGIN
  334.                    DEC(Place);
  335.                    sCursorLeft(1);
  336.                  END;
  337.                  Temp := '';
  338.                END ELSE IF Temp = CursorMove.Right[J] THEN BEGIN
  339.                  IF Place < BYTE(tLine[0]) + 1 THEN BEGIN
  340.                    INC(Place);
  341.                    sCursorRight(1);
  342.                  END;
  343.                  Temp := '';
  344.                END ELSE IF Temp = CursorMove.INSERT[J] THEN BEGIN
  345.                  Insrt := NOT Insrt;
  346.                  Temp  := '';
  347.                END ELSE IF Temp = CursorMove.DELETE[J] THEN BEGIN
  348.                  Temp := '';
  349.                  IF Place < BYTE(tLine[0]) + 1 THEN BEGIN
  350.                    DELETE(tLine,Place,1);
  351.                    IF ShowIt THEN sWrite(COPY(tLine,Place,255) + BackSpaceChar) ELSE BEGIN
  352.                      FOR Loop := Place TO LENGTH(tLine) DO sWrite('■');
  353.                      sWrite(BackSpaceChar);
  354.                    END;
  355.                    sCursorLeft(BYTE(tLine[0]) - Place + 1 + 1);
  356.                  END;
  357.                END;
  358.                INC(J);
  359.              UNTIL (J = 2) OR (Temp = '');
  360.            END;
  361.       #8 : IF Place <> 1 THEN BEGIN
  362.              IF Place = BYTE(tLine[0]) + 1 THEN BEGIN
  363.                DEC(tLine[0]);
  364.                sWrite(#8 + BackSpaceChar);
  365.                DEC(Place);
  366.              END ELSE BEGIN
  367.                DEC(Place);
  368.                DELETE(tLine,Place,1);
  369.                IF (ShowIt) AND (Graphics <> TTY) THEN BEGIN
  370.                  sCursorLeft(1);
  371.                  sWrite(COPY(tLine,Place,255) + BackSpaceChar)
  372.                END ELSE BEGIN
  373.                  sCursorLeft(1);
  374.                  FOR Loop := Place TO LENGTH(tLine) DO sWrite('■');
  375.                  sWrite(BackSpaceChar);
  376.                END;
  377.              END;
  378.              IF Graphics = TTY THEN SendStr(#8) ELSE sCursorLeft(LENGTH(COPY(tLine,Place,255) + BackSpaceChar));
  379.            END;
  380.       #1..#31 : ;
  381.       ELSE BEGIN
  382.         IF (LENGTH(tLine) <> Len) OR ((NOT Insrt) AND (Place - 1 <> Len)) THEN BEGIN
  383.           IF Place = LENGTH(tLine) + 1 THEN BEGIN
  384.             IF ShowIt THEN sWrite(Ch) ELSE sWrite('■');
  385.             tLine := tLine + Ch;
  386.             INC(Place);
  387.           END ELSE BEGIN
  388.             IF NOT Insrt THEN BEGIN
  389.               IF ShowIt THEN sWrite(Ch) ELSE sWrite('■');
  390.               tLine[Place] := Ch;
  391.               INC(Place);
  392.             END ELSE BEGIN
  393.               INSERT(Ch,tLine,Place);
  394.               IF ShowIt THEN sWrite(COPY(tLine,Place,255)) ELSE BEGIN
  395.                 FOR Loop := Place TO LENGTH(tLine) DO sWrite('■');
  396.               END;
  397.               sCursorLeft(LENGTH(COPY(tLine,Place,255)) - 1);
  398.               INC(Place);
  399.             END;
  400.           END;
  401.         END ELSE BEGIN
  402.           IF NOT WrapInput THEN sWrite(#7) ELSE BEGIN
  403.             Temp[0]  := #0;
  404.             RTemp[0] := #0;
  405.             Loop := BYTE(tLine[0]);
  406.             IF POS(#32,tLine) <> 0 THEN BEGIN
  407.               WHILE (tLine[loop] <> #32) DO BEGIN
  408.                 sWrite(#8 + BackSpaceChar);
  409.                 Temp := Temp + tLine[Loop];
  410.                 DEC(Loop);
  411.                 DEC(tLine[0]);
  412.               END;
  413.               IF Temp[0] <> #0 THEN FOR Loop := BYTE(Temp[0]) DOWNTO 1 DO RTemp := RTemp + Temp[Loop];
  414.             END;
  415.             Ch := #13;
  416.           END;
  417.         END;
  418.       END;
  419.     END;
  420.   UNTIL Ch = #13;
  421.   InputDriver := tLine;
  422.   sWriteln('');
  423. END;
  424. { ────────────────────────────────────────────────────────────────────────── }
  425. FUNCTION SecretInput(Len : BYTE; Default : STRING) : STRING;
  426. BEGIN
  427.   SecretInput := InputDriver(Len,FALSE,FALSE,FALSE,FALSE,Default);
  428. END;
  429. {──────────────────────────────────────────────────────────────────────────}
  430. FUNCTION NameInput(Len : BYTE; Default : STRING) : STRING;
  431. BEGIN
  432.   NameInput := InputDriver(Len,TRUE,TRUE,FALSE,FALSE,Default);
  433. END;
  434. {──────────────────────────────────────────────────────────────────────────}
  435. FUNCTION NormalInput(Len : BYTE; Default : STRING) : STRING;
  436. BEGIN
  437.   NormalInput := InputDriver(Len,FALSE,TRUE,FALSE,FALSE,Default);
  438. END;
  439. {──────────────────────────────────────────────────────────────────────────}
  440. FUNCTION CapsInput(Len : BYTE; Default : STRING) : STRING;
  441. BEGIN
  442.   CapsInput := InputDriver(Len,FALSE,TRUE,TRUE,FALSE,Default);
  443. END;
  444. {──────────────────────────────────────────────────────────────────────────}
  445. FUNCTION NumberInput(Len : BYTE; Default : STRING) : STRING;
  446. BEGIN
  447.   NumberInput := InputDriver(Len,FALSE,TRUE,FALSE,TRUE,Default);
  448. END;
  449. {───────────────────────────────────────────────────────────────────────────}
  450. FUNCTION NamePrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  451. VAR
  452.   X,Y,Loop : BYTE;
  453. BEGIN
  454.   X := WHEREX + 1;
  455.   Y := WHEREY;
  456.   BackSpaceChar := '_';
  457.   Set_Color(CS.Bfg,CS.Wbg);
  458.   sWriteC('[');
  459.   Set_Color(CS.Ffg,CS.Fbg);
  460.   sWrite(InStr);
  461.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  462.   Set_Color(CS.Bfg,CS.Wbg);
  463.   sWriteC(']');
  464.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X + LENGTH(InStr),Y);
  465.   Set_Color(CS.Ffg,CS.Fbg);
  466.   NamePrompt := NameInput(StrLength,InStr);
  467.   Set_Color(7,0);
  468. END;
  469. {───────────────────────────────────────────────────────────────────────────}
  470. FUNCTION NormalPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  471. VAR
  472.   X,Y,Loop : BYTE;
  473. BEGIN
  474.   X := WHEREX + 1;
  475.   Y := WHEREY;
  476.   BackSpaceChar := '_';
  477.   Set_Color(CS.Bfg,CS.Wbg);
  478.   sWriteC('[');
  479.   Set_Color(CS.Ffg,CS.Fbg);
  480.   sWrite(InStr);
  481.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  482.   Set_Color(CS.Bfg,CS.Wbg);
  483.   sWriteC(']');
  484.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X + LENGTH(InStr),Y);
  485.   Set_Color(CS.Ffg,CS.Fbg);
  486.   NormalPrompt := NormalInput(StrLength,InStr);
  487.   Set_Color(7,0);
  488. END;
  489. {───────────────────────────────────────────────────────────────────────────}
  490. FUNCTION NumberPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  491. VAR
  492.   X,Y,Loop : BYTE;
  493. BEGIN
  494.   X := WHEREX + 1;
  495.   Y := WHEREY;
  496.   BackSpaceChar := '_';
  497.   Set_Color(CS.Bfg,CS.Wbg);
  498.   sWriteC('[');
  499.   Set_Color(CS.Ffg,CS.Fbg);
  500.   sWrite(InStr);
  501.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  502.   Set_Color(CS.Bfg,CS.Wbg);
  503.   sWriteC(']');
  504.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X + LENGTH(InStr),Y);
  505.   Set_Color(CS.Ffg,CS.Fbg);
  506.   NumberPrompt := NumberInput(StrLength,InStr);
  507.   Set_Color(7,0);
  508. END;
  509. {───────────────────────────────────────────────────────────────────────────}
  510. FUNCTION SecretPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  511. VAR
  512.   X,Y,Loop : BYTE;
  513. BEGIN
  514.   X := WHEREX + 1;
  515.   Y := WHEREY;
  516.   BackSpaceChar := '_';
  517.   Set_Color(CS.Bfg,CS.Wbg);
  518.   sWriteC('[');
  519.   Set_Color(CS.Ffg,CS.Fbg);
  520.   FOR Loop := 1 TO StrLength DO sWriteC('_');
  521.   Set_Color(CS.Bfg,CS.Wbg);
  522.   sWriteC(']');
  523.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X + LENGTH(InStr),Y);
  524.   Set_Color(CS.Ffg,CS.Fbg);
  525.   SecretPrompt := SecretInput(StrLength,InStr);
  526.   Set_Color(7,0);
  527. END;
  528. {───────────────────────────────────────────────────────────────────────────}
  529. FUNCTION CapsPrompt(StrLength : BYTE ; InStr : STRING) : STRING;
  530. VAR
  531.   X,Y,Loop : BYTE;
  532. BEGIN
  533.   X := WHEREX + 1;
  534.   Y := WHEREY;
  535.   BackSpaceChar := '_';
  536.   OutTxt(CS.Bfg,CS.Wbg,'[');
  537.   Set_Color(CS.Ffg,CS.Fbg);
  538.   InStr := AllCaps(InStr); sWrite(InStr);
  539.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  540.   OutTxt(CS.Bfg,CS.Wbg,']');
  541.   IF InStr = '' THEN sGotoXY(X,Y) ELSE sGotoXY(X + LENGTH(InStr),Y);
  542.   Set_Color(CS.Ffg,CS.Fbg);
  543.   CapsPrompt := CapsInput(StrLength,InStr);
  544.   Set_Color(7,0);
  545. END;
  546. {───────────────────────────────────────────────────────────────────────────}
  547. FUNCTION SysField(X,Y,Style,StrLength : BYTE ; InStr : STRING) : STRING;
  548. VAR                  {^ 0-Normal 1-Number 2-Name 3-Secret 4-Caps}
  549.   OldFg,
  550.   OldBg,
  551.   OldBr,
  552.   Loop : BYTE;
  553. BEGIN
  554.   sGotoXY(X,Y);
  555.   OldFg  := CS.Ffg;
  556.   OldBg  := CS.Fbg;
  557.   OldBr  := CS.Bfg;
  558.   CS.Ffg := 15;
  559.   CS.Fbg := 0;
  560.   CS.Bfg := 14;
  561.   CASE Style OF
  562.     0 : InStr := NormalPrompt(StrLength,InStr);
  563.     1 : InStr := NumberPrompt(StrLength,InStr);
  564.     2 : InStr := NamePrompt(StrLength,InStr);
  565.     3 : InStr := SecretPrompt(StrLength,InStr);
  566.     4 : InStr := CapsPrompt(StrLength,InStr);
  567.   END;
  568.   CS.Ffg   := OldFg;
  569.   CS.Fbg   := OldBg;
  570.   CS.Bfg   := OldBr;
  571.   IF Style <> 3 THEN DummyField(X,Y,StrLength,InStr) ELSE DummyField(X,Y,StrLength,'');
  572.   SysField := InStr;
  573.   Set_Color(7,0);
  574. END;
  575. {───────────────────────────────────────────────────────────────────────────}
  576. PROCEDURE DummyField(X,Y,StrLength : BYTE ; InStr : STRING);
  577. VAR
  578.   Loop : BYTE;
  579. BEGIN
  580.   OutTxtXY(X,Y,CS.Wh,CS.Wbg,' ');
  581.   OutTxtXY(X + 1,Y,7,0,InStr);
  582.   FOR Loop := LENGTH(InStr) TO (StrLength - 1) DO sWriteC('_');
  583.   OutTxt(CS.Wh,CS.Wbg,' ');
  584.   Set_Color(7,0);
  585. END;
  586. {───────────────────────────────────────────────────────────────────────────}
  587. PROCEDURE DrawWin(X1,Y1,X2,Y2 : BYTE ; Title : STRING);
  588. CONST
  589.   Vs : CHAR = '█';
  590.   Hs : CHAR = '▀';
  591.   Tl : CHAR = '┌';
  592.   Tr : CHAR = '┐';
  593.   Bl : CHAR = '└';
  594.   Br : CHAR = '┘';
  595.   H  : CHAR = '─';
  596.   V  : CHAR = '│';
  597. VAR
  598.   X,L1,L2 : BYTE;
  599. BEGIN
  600.   sGotoXY(X1,Y1);
  601.   OutTxt(CS.Hfg,CS.Hbg,' ' + Title);
  602.   X := WHEREX;
  603.   FOR L1 := X TO X2 DO OutTxt(CS.Hfg,CS.Hbg,' ');
  604.   OutTxtXY(X1,Y1 + 1,CS.Wh,CS.Wbg,Tl);
  605.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wh,CS.Wbg,H);
  606.   OutTxtXY(X2,Y1 + 1,CS.Wl,CS.Wbg,Tr); OutTxt(CS.Sfg,CS.Sbg,Vs);
  607.   FOR L1 := (Y1 + 2) TO (Y2 - 1) DO BEGIN
  608.     OutTxtXY(X1,L1,CS.Wh,CS.Wbg,V);
  609.     FOR L2 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wh,CS.Wbg,' ');
  610.     OutTxt(CS.Wl,CS.Wbg,V); OutTxt(CS.Sfg,CS.Sbg,Vs);
  611.   END;
  612.   OutTxtXY(X1,Y2,CS.Wh,CS.Wbg,Bl);
  613.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(CS.Wl,CS.Wbg,H);
  614.   OutTxtXY(X2,Y2,CS.Wl,CS.Wbg,Br); OutTxt(CS.Sfg,CS.Sbg,Vs);
  615.   sGotoXY(X1 + 2,Y2 + 1);
  616.   FOR L1 := (X1 + 2) TO (X2 + 1) DO OutTxt(CS.Sfg,CS.Sbg,Hs);
  617.   Set_Color(7,0);
  618. END;
  619. {───────────────────────────────────────────────────────────────────────────}
  620. PROCEDURE ClearWin(X1,Y1,X2,Y2 : BYTE);
  621. VAR
  622.   L1,L2 : BYTE;
  623. BEGIN
  624.   FOR L1 := Y1 TO Y2 DO BEGIN
  625.     sGotoXY(X1,L1);
  626.     FOR L2 := X1 TO X2 DO OutTxt(CS.Wh,CS.Wbg,' ');
  627.   END;
  628.   Set_Color(7,0);
  629. END;
  630. {───────────────────────────────────────────────────────────────────────────}
  631. PROCEDURE DrawButton(HotKey : CHAR ; Txt : STRING ; HighLight : BOOLEAN);
  632. VAR
  633.   BL,BR : CHAR;
  634.   FG    : BYTE;
  635. BEGIN
  636.   BR := '▌'; BL := '▐';
  637.   OutTxt(8,0,BL);
  638.   IF HighLight THEN FG := 1 ELSE FG := 8;
  639.   IF HighLight THEN OutTxt(4,7,' ' + HotKey);
  640.   IF NOT HighLight THEN OutTxt(8,7,' ' + HotKey);
  641.   OutTxt(FG,7,Txt + ' ');
  642.   OutTxt(8,0,BR);
  643. END;
  644. {───────────────────────────────────────────────────────────────────────────}
  645. PROCEDURE SysButton(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  646. VAR
  647.   L1,Sfg,Sbg : BYTE;
  648.   Vs,Hs      : CHAR;
  649. BEGIN
  650.   Vs := '▄';
  651.   Hs := '▀';
  652.   OutTxtXY(X,Y,4,7,' ' + HotKey);
  653.   OutTxt(0,7,Txt + ' ');
  654.   OutTxt(0,CS.Wbg,Vs);
  655.   sGotoXY(X + 1,Y + 1);
  656.   FOR L1 := 1 TO (LENGTH(Txt) + 3) DO OutTxt(0,CS.Wbg,Hs);
  657.   Set_Color(7,0);
  658. END;
  659. {───────────────────────────────────────────────────────────────────────────}
  660. PROCEDURE DrawMenu(X1,Y1,X2,Y2 : BYTE);
  661. CONST
  662.   Vs : CHAR = '█';
  663.   Hs : CHAR = '▀';
  664.   Tl : CHAR = '┌';
  665.   Tr : CHAR = '┐';
  666.   Bl : CHAR = '└';
  667.   Br : CHAR = '┘';
  668.   H  : CHAR = '─';
  669.   V  : CHAR = '│';
  670. VAR
  671.   L1,L2 : BYTE;
  672. BEGIN
  673.   sGotoXY(X1,Y1);
  674.   OutTxtXY(X1,Y1,0,7,Tl);
  675.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,H);
  676.   OutTxtXY(X2,Y1,0,7,Tr);
  677.   FOR L1 := (Y1 + 1) TO (Y2 - 1) DO BEGIN
  678.     OutTxtXY(X1,L1,0,7,V);
  679.     FOR L2 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,' ');
  680.     OutTxt(0,7,V);
  681.     OutTxt(CS.Sfg,CS.Sbg,Vs);
  682.   END;
  683.   OutTxtXY(X1,Y2,0,7,Bl);
  684.   FOR L1 := (X1 + 1) TO (X2 - 1) DO OutTxt(0,7,H);
  685.   OutTxtXY(X2,Y2,0,7,Br); OutTxt(CS.Sfg,CS.Sbg,Vs);
  686.   Set_Color(CS.Sfg,CS.Sbg);
  687.   sGotoXY(X1 + 2,Y2 + 1);
  688.   FOR L1 := (X1 + 2) TO (X2 + 1) DO sWriteC(Hs);
  689.   Set_Color(7,0);
  690. END;
  691. {───────────────────────────────────────────────────────────────────────────}
  692. PROCEDURE MenuItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  693. BEGIN
  694.   OutTxtXY(X,Y,1,7,HotKey);
  695.   OutTxt(0,7,Txt);
  696.   Set_Color(7,0);
  697. END;
  698. {───────────────────────────────────────────────────────────────────────────}
  699. PROCEDURE MenuLine(X,Y,L : BYTE);
  700. VAR
  701.   Loop : BYTE;
  702. BEGIN
  703.   OutTxtXY(X,Y,0,7,'├');
  704.   FOR Loop := 1 TO (L - 2) DO OutTxt(0,7,'─');
  705.   OutTxt(0,7,'┤');
  706.   Set_Color(7,0);
  707. END;
  708. {───────────────────────────────────────────────────────────────────────────}
  709. PROCEDURE MenuBarItem(X,Y : BYTE ; HotKey : CHAR ; Txt : STRING);
  710. BEGIN
  711.   OutTxtXY(X,Y,4,7,HotKey);
  712.   OutTxt(0,7,Txt);
  713.   Set_Color(7,0);
  714. END;
  715. {───────────────────────────────────────────────────────────────────────────}
  716. PROCEDURE InfoBox(Width : BYTE ; Height : BYTE);
  717. CONST
  718.   LTC  : CHAR = '╔';
  719.   RTC  : CHAR = '╗';
  720.   LBC  : CHAR = '╚';
  721.   RBC  : CHAR = '╝';
  722.   HBAR : CHAR = '═';
  723.   VBAR : CHAR = '║';
  724. VAR
  725.   Row,Loop : BYTE;
  726. BEGIN
  727.   Row := WHEREY;
  728.   Set_Color(9,0);
  729.   sGotoXY(1,Row); sWriteC(LTC);
  730.   FOR Loop := 2 TO (Width - 1) DO sWriteC(HBAR);
  731.   Set_Color(1,0); sWriteln(RTC);
  732.   Row := WHEREY;
  733.   FOR Loop := 1 TO Height DO BEGIN
  734.     Set_Color(9,0);
  735.     sGotoXY(1,Row); sWriteC(VBAR);
  736.     Set_Color(1,0);
  737.     sGotoXY(Width,Row); sWriteln(VBAR);
  738.     Row := WHEREY;
  739.   END;
  740.   Set_Color(9,0);
  741.   sWriteC(LBC);
  742.   Set_Color(1,0);
  743.   FOR Loop := 2 TO (Width - 1) DO sWriteC(HBAR);
  744.   sGotoXY(Width,Row); sWriteln(RBC);
  745. END;
  746. {───────────────────────────────────────────────────────────────────────────}
  747. PROCEDURE InfoText(Txt : STRING);
  748. VAR
  749.   LB,RB : STRING[4];
  750. BEGIN
  751.   LB := '░▒▓█';
  752.   RB := '█▓▒░';
  753.   Set_Color(1,0);  sWrite(LB);
  754.   Set_Color(15,1); sWrite(Txt);
  755.   Set_Color(1,0);  sWrite(RB);
  756. END;
  757. {───────────────────────────────────────────────────────────────────────────}
  758. PROCEDURE RunEntryForm(ScriptFile : STRING);
  759. TYPE EntryFields = ARRAY[1..50] OF STRING;
  760. VAR
  761.   Go1,
  762.   Go2,Go3,
  763.   GotText : BOOLEAN;
  764.   OldGfx,
  765.   Loop,FC : BYTE;
  766.   Scrn,
  767.   InFile,
  768.   OutFile : TEXT;
  769.   Cmd,
  770.   V1,V2,
  771.   ScrLine : STRING;
  772.   _Field  : ^EntryFields;
  773. BEGIN
  774.   IF NOT FExist(ScriptFile) THEN EXIT;
  775.   NEW(_Field);
  776.   sClrScr;
  777.   GotText := FALSE; FC := 0;
  778.   ASSIGN(InFile,ScriptFile);
  779.   RESET(InFile);
  780.   WHILE NOT EOF(InFile) DO BEGIN
  781.     Go1 := TRUE; Go2 := FALSE; Go3 := FALSE;
  782.     Cmd := ''; V1 := ''; V2 := '';
  783.     READLN(InFile,ScrLine);
  784.     ScrLine := CvtVars(ScrLine);
  785.     FOR Loop := 1 TO LENGTH(ScrLine) DO BEGIN
  786.       IF (Go2) AND (ScrLine[Loop] = '@') THEN BEGIN
  787.         Go1 := FALSE;
  788.         Go2 := FALSE;
  789.         Go3 := TRUE;
  790.       END;
  791.       IF Go1 THEN Cmd := Cmd + ScrLine[Loop];
  792.       IF Go2 THEN V1 := V1 + ScrLine[Loop];
  793.       IF (Go3) AND (ScrLine[Loop] <> '@') THEN V2 := V2 + ScrLine[Loop];
  794.       IF (Go1) AND (ScrLine[Loop] = '@') THEN BEGIN
  795.         Go1 := FALSE;
  796.         Go2 := TRUE;
  797.         Go3 := FALSE;
  798.       END;
  799.     END;
  800.     Cmd := AllCaps(Cmd);
  801.     IF Cmd = 'SCREENFILE@' THEN BEGIN
  802.       V1     := AllCaps(V1);
  803.       OldGfx := Graphics;
  804.       CASE Graphics OF
  805.         RIP  : IF FExist(V1 + '.RIP') THEN ShowScreen(V1 + '.RIP') ELSE BEGIN
  806.                  RipToText;
  807.                  Graphics := ANSI;
  808.                END;
  809.         MAX  : IF FExist(V1 + '.MAX') THEN ShowScreen(V1 + '.MAX') ELSE BEGIN
  810.                  RipToText;
  811.                  Graphics := ANSI;
  812.                END;
  813.       AVATAR : IF FExist(V1 + '.AVT') THEN ShowScreen(V1 + '.AVT')
  814.                                       ELSE Graphics := ANSI;
  815.         ANSI : IF FExist(V1 + '.ANS') THEN ShowScreen(V1 + '.ANS')
  816.                                       ELSE Graphics := TTY;
  817.         TTY  : ShowScreen(V1 + '.ASC');
  818.       END;
  819.       sWriteln('');
  820.       Graphics := OldGfx;
  821.     END;
  822.     IF (Cmd = 'TEXTFILE@') AND (NOT GotText) THEN BEGIN
  823.       GotText := TRUE;
  824.       V1 := AllCaps(V1);
  825.       ASSIGN(OutFile,V1);
  826.       IF NOT FExist(V1) THEN REWRITE(OutFile) ELSE APPEND(OutFile);
  827.     END;
  828.     IF Cmd = 'PROMPTTEXT@' THEN BEGIN
  829.       Set_Color(CS.CPTfg,CS.CPTbg);
  830.       CvtColors(V1,FALSE);
  831.     END;
  832.     IF Cmd = 'LINEFEED@' THEN sWriteln('');
  833.     IF Cmd = 'ANYKEY@' THEN AnyKey;
  834.     IF Cmd = 'PROPERPROMPT@' THEN BEGIN
  835.       INC(FC); sWriteC(' ');
  836.       IF Graphics = TTY THEN _Field^[FC] := NameInput(StrToInt(V1),V2)
  837.                         ELSE _Field^[FC] := NamePrompt(StrToInt(V1),V2);
  838.     END;
  839.     IF Cmd = 'NORMALPROMPT@' THEN BEGIN
  840.       INC(FC); sWriteC(' ');
  841.       IF Graphics = TTY THEN _Field^[FC] := NormalInput(StrToInt(V1),V2)
  842.                         ELSE _Field^[FC] := NormalPrompt(StrToInt(V1),V2);
  843.     END;
  844.     IF Cmd = 'NUMBERPROMPT@' THEN BEGIN
  845.       INC(FC); sWriteC(' ');
  846.       IF Graphics = TTY THEN _Field^[FC] := NumberInput(StrToInt(V1),V2)
  847.                         ELSE _Field^[FC] := NumberPrompt(StrToInt(V1),V2);
  848.     END;
  849.     IF Cmd = 'CAPITALPROMPT@' THEN BEGIN
  850.       INC(FC); sWriteC(' ');
  851.       IF Graphics = TTY THEN _Field^[FC] := CapsInput(StrToInt(V1),V2)
  852.                         ELSE _Field^[FC] := CapsPrompt(StrToInt(V1),V2);
  853.     END;
  854.     IF Cmd = 'HIDDENPROMPT@' THEN BEGIN
  855.       INC(FC); sWriteC(' ');
  856.       IF Graphics = TTY THEN _Field^[FC] := SecretInput(StrToInt(V1),V2)
  857.                         ELSE _Field^[FC] := SecretPrompt(StrToInt(V1),V2);
  858.     END;
  859.     IF Cmd = 'OUTTEXT@' THEN BEGIN
  860.       IF V2 <> '' THEN WRITE(OutFile,V1)
  861.                   ELSE WRITELN(OutFile,V1);
  862.       IF (V2 <> '') AND (StrToInt(V2) <= FC) THEN WRITELN(OutFile,_Field^[StrToInt(V2)]);
  863.     END;
  864.     IF Cmd = 'RUNBATCHFILE@' THEN BEGIN
  865.       RipToText;
  866.       RunBatFile(V1);
  867.     END;
  868.     IF Cmd = 'SHOWTEXTFILE@' THEN ShowTextFile(V1);
  869.     IF Cmd = 'CLS@' THEN sClrScr;
  870.   END;
  871.   DISPOSE(_Field);
  872.   IF GotText THEN CLOSE(OutFile);
  873.   CLOSE(InFile);
  874. END;
  875. {───────────────────────────────────────────────────────────────────────────}
  876. FUNCTION GoodColor(TempStr : STRING ; ChangeColor : BOOLEAN) : BOOLEAN;
  877. VAR
  878.   FG : BYTE;
  879. BEGIN
  880.   FG := 50;
  881.   IF TempStr = '{0}'  THEN FG := 0;
  882.   IF TempStr = '{1}'  THEN FG := 1;
  883.   IF TempStr = '{2}'  THEN FG := 2;
  884.   IF TempStr = '{3}'  THEN FG := 3;
  885.   IF TempStr = '{4}'  THEN FG := 4;
  886.   IF TempStr = '{5}'  THEN FG := 5;
  887.   IF TempStr = '{6}'  THEN FG := 6;
  888.   IF TempStr = '{7}'  THEN FG := 7;
  889.   IF TempStr = '{8}'  THEN FG := 8;
  890.   IF TempStr = '{9}'  THEN FG := 9;
  891.   IF TempStr = '{10}' THEN FG := 10;
  892.   IF TempStr = '{11}' THEN FG := 11;
  893.   IF TempStr = '{12}' THEN FG := 12;
  894.   IF TempStr = '{13}' THEN FG := 13;
  895.   IF TempStr = '{14}' THEN FG := 14;
  896.   IF TempStr = '{15}' THEN FG := 15;
  897.   IF TempStr = '{16}' THEN FG := 16;
  898.   IF TempStr = '{17}' THEN FG := 17;
  899.   IF TempStr = '{18}' THEN FG := 18;
  900.   IF TempStr = '{19}' THEN FG := 19;
  901.   IF TempStr = '{20}' THEN FG := 20;
  902.   IF TempStr = '{21}' THEN FG := 21;
  903.   IF TempStr = '{22}' THEN FG := 22;
  904.   IF TempStr = '{23}' THEN FG := 23;
  905.   IF TempStr = '{24}' THEN FG := 24;
  906.   IF TempStr = '{25}' THEN FG := 25;
  907.   IF TempStr = '{26}' THEN FG := 26;
  908.   IF TempStr = '{27}' THEN FG := 27;
  909.   IF TempStr = '{28}' THEN FG := 28;
  910.   IF TempStr = '{29}' THEN FG := 29;
  911.   IF TempStr = '{30}' THEN FG := 30;
  912.   IF TempStr = '{31}' THEN FG := 31;
  913.   IF FG <> 50 THEN BEGIN
  914.     IF ChangeColor THEN SetFore(FG);
  915.     GoodColor := TRUE;
  916.   END ELSE GoodColor := FALSE;
  917. END;
  918. {───────────────────────────────────────────────────────────────────────────}
  919. FUNCTION StripColors(InStr : STRING) : STRING;
  920. VAR
  921.   Loop : BYTE;
  922.   Cvt  : BOOLEAN;
  923.   Temp : STRING;
  924.   Hold : STRING;
  925. BEGIN
  926.   Cvt  := FALSE;
  927.   Temp := '';
  928.   Hold := '';
  929.   FOR Loop := 1 TO LENGTH(InStr) DO BEGIN
  930.     IF InStr[Loop] = '{' THEN Cvt := TRUE;
  931.     IF Cvt THEN Temp := Temp + InStr[Loop]
  932.            ELSE Hold := Hold + InStr[Loop];
  933.     IF ((Cvt) AND (InStr[Loop] = '}')) OR (Loop = LENGTH(InStr)) THEN BEGIN
  934.       IF NOT GoodColor(Temp,FALSE) THEN Hold := Hold + Temp;
  935.       Cvt  := FALSE;
  936.       Temp := '';
  937.     END;
  938.   END;
  939.   StripColors := Hold;
  940. END;
  941. {───────────────────────────────────────────────────────────────────────────}
  942. PROCEDURE CvtColors(InStr : STRING ; LF : BOOLEAN);
  943. VAR
  944.   Loop : BYTE;
  945.   Cvt  : BOOLEAN;
  946.   Temp : STRING;
  947. BEGIN
  948.   Cvt  := FALSE;
  949.   Temp := '';
  950.   FOR Loop := 1 TO LENGTH(InStr) DO BEGIN
  951.     IF InStr[Loop] = '{' THEN Cvt := TRUE;
  952.     IF NOT Cvt THEN sWriteC(InStr[Loop]);
  953.     IF Cvt THEN Temp := Temp + InStr[Loop];
  954.     IF (Cvt) AND (InStr[Loop] = '}') THEN BEGIN
  955.       IF NOT GoodColor(Temp,TRUE) THEN sWrite(Temp);
  956.       Cvt  := FALSE;
  957.       Temp := '';
  958.     END;
  959.   END;
  960.   IF LF THEN sWriteln('');
  961. END;
  962. {───────────────────────────────────────────────────────────────────────────}
  963. PROCEDURE RipToText;
  964. BEGIN
  965.   Set_Color(0,0);
  966.   SendStr(#13#10);
  967.   SendStr(AnsiColor + '!|1K|*|#|#|#' + #13#10);
  968.   Set_Color(7,0);
  969.   sClrScr;
  970. END;
  971. {───────────────────────────────────────────────────────────────────────────}
  972. PROCEDURE ShowTextFile(TextFile : STRING);
  973. TYPE TextData = RECORD
  974.      TLine    : STRING;
  975.      END;
  976. VAR
  977.   T         : TextData;
  978.   TDat      : FILE OF TextData;
  979.   Ch        : CHAR;
  980.   Count,
  981.   SvgaY,
  982.   Loop,Cnt  : INTEGER;
  983.   File_Name : TEXT;
  984. BEGIN;
  985.   IF Graphics = RIP THEN RipToText;
  986.   IF Graphics <> MAX THEN sClrScr;
  987.   ASSIGN(File_Name,TextFile);
  988.   ASSIGN(TDat,GetFilePath(TextFile) + 'TEXT' + IntToStr(DoorSys.Node) + '.DAT');
  989.   IF NOT FExist(TextFile) THEN BEGIN
  990.     ErrorLog('Text File Not Found: ' + TextFile,6,FALSE);
  991.     EXIT;
  992.   END;
  993.   IF (NOT Local) AND (Graphics IN [MAX,RIP,AVATAR]) THEN BEGIN
  994.     DVWrite(2,24,15,PadRight('Displaying Text File: ' + CvtVars(GetFileName(TextFile)),' ',78));
  995.   END;
  996.   RESET(File_Name);
  997.   REWRITE(TDat);
  998.   Count := 0;
  999.   Cnt   := 0;
  1000.   IF Graphics = MAX THEN BEGIN
  1001.     SendStr(#13#10);
  1002.     SendStr(#12#13#10);
  1003.     SendStr(' ~² '+#13#10);
  1004.     SendStr(' ~Ç1,21,638,47,1,''Text Reader'' '+#13#10);
  1005.     SendStr(' ~ƒ1,48,637,349,246 '+#13#10);
  1006.     SendStr(' ~ó0,47,638,350,8 '+#13#10);
  1007.     SendStr(' ~ƒ1,351,637,390,243 '+#13#10);
  1008.     SendStr(' ~ó0,350,638,391,8 '+#13#10);
  1009.     SendStr(' ~É1,351,637,390 '+#13#10);
  1010.     SendStr(' ~«10,361,80,20,81 '+#13#10);
  1011.     SendStr(' ~«100,361,80,20,84 '+#13#10);
  1012.     SendStr(' ~«190,361,80,20,66 '+#13#10);
  1013.     SendStr(' ~«280,361,80,20,80 '+#13#10);
  1014.     SendStr(' ~«370,361,80,20,13 '+#13#10);
  1015.     SendStr(' ~Ä38,363,4,2,''Q{0}uit'' '+#13#10);
  1016.     SendStr(' ~Ä128,363,4,2,''T{0}op'' '+#13#10);
  1017.     SendStr(' ~Ä209,363,4,2,''B{0}ottom'' '+#13#10);
  1018.     SendStr(' ~Ä295,363,4,2,''P{0}revious'' '+#13#10);
  1019.     SendStr(' ~Ä394,363,4,2,''M{0}ore'' '+#13#10);
  1020.     SendStr(' ~■ '+#13#10);
  1021.     SendStr(' ~»0 ' + #13#10);
  1022.     SendStr(' ~ï ' + #13#10);
  1023.   END;
  1024.   WHILE NOT EOF (File_Name) DO BEGIN
  1025.     INC(Cnt);
  1026.     READLN(File_Name,T.TLine);
  1027.     FOR Count := 1 TO LENGTH(T.TLine) DO IF T.TLine[Count] = ' ' THEN T.TLine[Count] := ' ';
  1028.     T.TLine := CvtVars(T.TLine);
  1029.     WRITE(TDat,T);
  1030.   END;
  1031.   CLOSE(File_Name);
  1032.   RESET(TDat);
  1033.   Count := 0;
  1034.   SvgaY := 38;
  1035.   WHILE NOT EOF(TDat) DO BEGIN
  1036.     INC(Count);
  1037.     READ(TDat,T);
  1038.     IF Graphics <> MAX THEN BEGIN
  1039.       Set_Color(CS.TxFG,0);
  1040.       CvtColors(T.TLine,TRUE);
  1041.     END ELSE BEGIN
  1042.       INC(SvgaY,14);
  1043.       SendStr(' ~Ä5,' + IntToStr(SvgaY) + ',0,3,' + #39 + T.TLine + #39 + ' ' + #13#10);
  1044.     END;
  1045.     IF (Count = 21) OR EOF(TDat) THEN BEGIN
  1046.       IF Graphics <> MAX THEN BEGIN
  1047.         Set_Color(7,0);
  1048.         LineBar(1,0,79);
  1049.         CPrompt('Q','uit'); CPrompt('T','op'); CPrompt('B','ottom'); CPrompt('P','revious'); CPrompt('M','ore');
  1050.       END;
  1051.       IF Graphics = MAX THEN SendStr(' ~î ' + #13#10);
  1052.       REPEAT Ch := UPCASE(sReadKey) UNTIL Ch IN ['Q','T','B','P','M',#13,#27];
  1053.       IF Ch = #27 THEN Ch := 'Q';
  1054.       CASE Ch OF
  1055.         'Q' : BEGIN
  1056.                 CLOSE(TDat);
  1057.                 ERASE(TDat);
  1058.                 EXIT;
  1059.               END;
  1060.         'T' : BEGIN
  1061.                 Count := 0;
  1062.                 SEEK(TDat,Count);
  1063.               END;
  1064.         'B' : BEGIN
  1065.                 Count := Cnt - 21;
  1066.                 IF Count < 0 THEN Count := 0;
  1067.                 SEEK(TDat,Count);
  1068.                 Count := 0;
  1069.               END;
  1070.         'P' : BEGIN
  1071.                 Count := (FILEPOS(TDat) - 42);
  1072.                 IF Count < 0 THEN Count := 0;
  1073.                 SEEK(TDat,Count);
  1074.                 Count := 0;
  1075.               END;
  1076.         ELSE Count := 0;
  1077.       END;
  1078.       IF (Graphics = MAX) AND (Ch <> 'Q') AND (NOT EOF(TDat)) THEN BEGIN
  1079.         SvgaY := 38;
  1080.         SendStr(' ~ï ' + #13#10);
  1081.         SendStr(' ~ƒ1,48,637,349,246 ' + #13#10);
  1082.       END;
  1083.       IF (Graphics <> MAX) AND (Ch <> 'Q') AND (NOT EOF(TDat)) THEN sClrScr;
  1084.     END;
  1085.   END;
  1086.   CLOSE(TDat);
  1087.   ERASE(TDat);
  1088. END;
  1089. {───────────────────────────────────────────────────────────────────────────}
  1090. PROCEDURE ShowScreen(Scr : STRING);
  1091. VAR
  1092.   DoAnsi    : BOOLEAN;
  1093.   Ch        : CHAR;
  1094.   Loop1     : WORD;
  1095.   Loop2     : WORD;
  1096.   LN        : STRING;
  1097.   File_Name : TEXT;
  1098. BEGIN;
  1099.   Scr := AllCaps(Scr);
  1100.   IF NOT FExist(Scr) THEN EXIT;
  1101.   HideCursor;
  1102.   IF (Graphics = RIP) OR (Graphics = MAX) THEN BEGIN
  1103.     IF (Graphics = RIP) OR ((Graphics = MAX) AND (NOT NoKill)) THEN BEGIN
  1104.       SendStr(#13#10);
  1105.       SendStr(#12#13#10);
  1106.     END;
  1107.     IF NOT ShowLog THEN CLRSCR;
  1108.   END;
  1109.   IF Graphics = TTY THEN sClrScr;
  1110.   IF (NOT Local) AND (Graphics IN [MAX,RIP,AVATAR]) THEN BEGIN
  1111.     DVWrite(2,24,15,PadRight('Displaying Screen File: ' + CvtVars(GetFileName(Scr)),' ',78));
  1112.   END;
  1113.   Loop1 := 0;
  1114.   Loop2 := 0;
  1115.   ASSIGN(File_Name,Scr);
  1116.   DoAnsi := FALSE;
  1117.   IF POS('.ANS',Scr) > 0 THEN BEGIN
  1118.     RESET(File_Name);
  1119.     WHILE NOT EOF(File_Name) DO BEGIN
  1120.       READ(File_Name,Ch);
  1121.       IF Ch = #27 THEN DoAnsi := TRUE;
  1122.     END;
  1123.   END;
  1124.   RESET(File_Name);
  1125.   WHILE NOT EOF(File_Name) DO BEGIN
  1126.     INC(Loop1);
  1127.     READLN(File_Name,LN);
  1128.   END;
  1129.   CLOSE(File_Name);
  1130.   RESET(File_Name);
  1131.   WHILE NOT EOF(File_Name) DO BEGIN
  1132.     INC(Loop2);
  1133.     READLN(File_Name,LN);
  1134.     LN := CvtVars(LN);
  1135.     CASE Graphics OF
  1136.       MAX, RIP, AVATAR : SendStr(LN + #13#10);
  1137.       ANSI : IF DoAnsi THEN BEGIN
  1138.                IF Loop2 < Loop1 THEN BEGIN
  1139.                  SendStr(LN + #13#10);
  1140.                  DisplayANSIstr(LN + #13#10);
  1141.                END ELSE BEGIN
  1142.                  SendStr(LN);
  1143.                  DisplayANSIstr(LN);
  1144.                END;
  1145.              END ELSE BEGIN
  1146.                IF Loop2 < Loop1 THEN CvtColors(LN,TRUE)
  1147.                                 ELSE CvtColors(LN,FALSE);
  1148.              END;
  1149.       TTY  : IF Loop2 < Loop1 THEN sWriteln(LN) ELSE sWrite(LN);
  1150.     END;
  1151.     IF NOT Carrier THEN BEGIN
  1152.       ErrLevel := 3;
  1153.       HALT(ErrLevel);
  1154.     END;
  1155.   END;
  1156.   CLOSE(File_Name);
  1157.   NoKill := FALSE;
  1158.   ShowCursor;
  1159.   CurColor := TextAttr;
  1160. END;
  1161. {───────────────────────────────────────────────────────────────────────────}
  1162. PROCEDURE IceText(S : STRING ; LF : BOOLEAN);
  1163. VAR
  1164.   TLength : BYTE;
  1165.   Loop    : BYTE;
  1166. BEGIN
  1167.   TLength  := LENGTH(S);
  1168.   FOR Loop := 1 TO TLength DO BEGIN
  1169.     IF (ORD(S[Loop]) >= 65) AND (ORD(S[Loop]) <= 90) THEN Set_Color(15,0) ELSE
  1170.     IF (ORD(S[Loop]) >= 97) AND (ORD(S[Loop]) <= 122) THEN Set_Color(11,0) ELSE
  1171.     IF (ORD(S[Loop]) > 127) OR (ORD(S[Loop]) < 32) THEN Set_Color(1,0) ELSE Set_Color(9,0);
  1172.     sWrite(S[Loop]);
  1173.   END;
  1174.   IF LF THEN sWriteln('');
  1175. END;
  1176. {───────────────────────────────────────────────────────────────────────────}
  1177. PROCEDURE nstText(S : STRING ; LF : BOOLEAN);
  1178. VAR
  1179.   Len  : BYTE;
  1180.   Loop : BYTE;
  1181.   Bool : BOOLEAN;
  1182. BEGIN
  1183.   Len  := LENGTH(S);
  1184.   Bool := FALSE;
  1185.   FOR Loop := 1 TO Len DO BEGIN
  1186.     IF S[Loop] IN ['.',':','■'] THEN Set_Color(8,0) ELSE
  1187.     IF Bool THEN Set_Color(11,0) ELSE Set_Color(3,0);
  1188.     IF S[Loop] = ' : ' THEN Bool := TRUE;
  1189.     sWrite(S[Loop]);
  1190.   END;
  1191.   IF LF THEN sWriteln('');
  1192. END;
  1193. {───────────────────────────────────────────────────────────────────────────}
  1194. PROCEDURE FullScreenChat;
  1195. VAR
  1196.   FG,
  1197.   Loop,
  1198.   UserX,
  1199.   UserY,
  1200.   SysopX,
  1201.   SysopY   : BYTE;
  1202.   Quit     : BOOLEAN;
  1203.   Ch       : CHAR;
  1204.   SText,
  1205.   UText    : STRING[80];
  1206. BEGIN
  1207.   DoorSys.UpdateSecs := FALSE;
  1208.   DoorSys.UpdateIdle := FALSE;
  1209.   sClrScr;
  1210.   InfoText(Center(ProgramName,71));
  1211.   sGotoXY(1,2); InfoBox(79,8);
  1212.   InfoText(Center(ProgramDesc,71));
  1213.   sGotoXY(1,13); InfoBox(79,8);
  1214.   InfoText('CTRL-W (Clear Window)                               CTRL-Y (Clear Line)');
  1215.   DVWrite(1,24,8,Center('Press The ESCape Key To Terminate Chat Mode!',79));
  1216.   sGotoXY(3,2);  IceText(' ' + #31 + ' ' + Ctl.SFirst + ' ' + Ctl.SLast + ' ' + #31 + ' ',FALSE);
  1217.   sGotoXY(3,13); IceText(' ' + #31 + ' ' + DoorSys.UserName + ' ' + #31 + ' ',FALSE);
  1218.   SysopX   := 2;
  1219.   SysopY   := 3;
  1220.   UserX    := 2;
  1221.   UserY    := 14;
  1222.   Quit     := FALSE;
  1223.   DoorSys.LocalKey := TRUE;
  1224.   sGotoXY(2,3);
  1225.   Set_Color(7,0);
  1226.   WITH DoorSys DO REPEAT
  1227.     REPEAT Ch := sReadKey UNTIL Ch IN [#0,#8,#13,#23,#25,#27,' '..#255];
  1228.     CASE Ch OF
  1229.       #0 : BEGIN
  1230.              sReadKey;
  1231.              Ch := #0;
  1232.            END;
  1233.       #8 : IF LocalKey THEN BEGIN
  1234.              DEC(SysopX);
  1235.              DELETE(SText,LENGTH(SText),1);
  1236.              IF SysopX < 2 THEN SysopX := 2;
  1237.              Ch := #0;
  1238.              sGotoXY(SysopX,SysopY); sWrite(' ');
  1239.              sGotoXY(SysopX,SysopY);
  1240.            END ELSE BEGIN
  1241.              DEC(UserX);
  1242.              DELETE(UText,LENGTH(UText),1);
  1243.              IF UserX < 2 THEN UserX := 2;
  1244.              Ch := #0;
  1245.              sGotoXY(UserX,UserY); sWrite(' ');
  1246.              sGotoXY(UserX,UserY);
  1247.            END;
  1248.       #13 : IF LocalKey THEN BEGIN
  1249.              SysopX := 2;
  1250.              SText  := '';
  1251.              INC(SysopY);
  1252.              IF SysopY > 10 THEN SysopY := 3;
  1253.              sGotoXY(SysopX,SysopY);
  1254.              sWrite(PadRight(' ',' ',77));
  1255.              IF SysopY < 10 THEN sGotoXY(SysopX,SysopY + 1) ELSE sGotoXY(SysopX,3);
  1256.              sWrite(PadRight(' ',' ',77));
  1257.              sGotoXY(SysopX,SysopY);
  1258.              Ch := #0;
  1259.            END ELSE BEGIN
  1260.              UserX := 2;
  1261.              UText := '';
  1262.              INC(UserY);
  1263.              IF UserY > 21 THEN UserY := 14;
  1264.              sGotoXY(UserX,UserY);
  1265.              sWrite(PadRight(' ',' ',77));
  1266.              IF UserY < 21 THEN sGotoXY(UserX,UserY + 1) ELSE sGotoXY(UserX,14);
  1267.              sWrite(PadRight(' ',' ',77));
  1268.              sGotoXY(UserX,UserY);
  1269.              Ch := #0;
  1270.            END;
  1271.       #23 : IF LocalKey THEN BEGIN
  1272.              FOR Loop := 3 TO 10 DO BEGIN
  1273.                sGotoXY(2,Loop);
  1274.                sWrite(PadRight(' ',' ',77));
  1275.              END;
  1276.              SysopX := 2;
  1277.              SysopY := 3;
  1278.              SText  := '';
  1279.              sGotoXY(SysopX,SysopY);
  1280.              Ch := #0;
  1281.            END ELSE BEGIN
  1282.              FOR Loop := 14 TO 21 DO BEGIN
  1283.                sGotoXY(2,Loop);
  1284.                sWrite(PadRight(' ',' ',77));
  1285.              END;
  1286.              UserX := 2;
  1287.              UserY := 14;
  1288.              UText := '';
  1289.              sGotoXY(UserX,UserY);
  1290.              Ch := #0;
  1291.            END;
  1292.       #25 : IF LocalKey THEN BEGIN
  1293.              SysopX := 2;
  1294.              SText  := '';
  1295.              sGotoXY(SysopX,SysopY);
  1296.              sWrite(PadRight(' ',' ',77));
  1297.              sGotoXY(SysopX,SysopY);
  1298.              Ch := #0;
  1299.            END ELSE BEGIN
  1300.              UserX := 2;
  1301.              UText := '';
  1302.              sGotoXY(UserX,UserY);
  1303.              sWrite(PadRight(' ',' ',77));
  1304.              sGotoXY(UserX,UserY);
  1305.              Ch := #0;
  1306.            END;
  1307.       #27 : IF NOT LocalKey THEN BEGIN
  1308.              DELAY(50);
  1309.              WHILE sKeyPressed DO sReadKey;
  1310.              Ch := #0;
  1311.            END;
  1312.     END;
  1313.     Quit := Ch = #27;
  1314.     IF (ORD(Ch) >= 65) AND (ORD(Ch) <= 90) THEN FG := 15 ELSE
  1315.     IF (ORD(Ch) >= 97) AND (ORD(Ch) <= 122) THEN FG := 11 ELSE
  1316.     IF (ORD(Ch) > 127) OR (ORD(Ch) < 32) THEN FG := 1 ELSE FG := 9;
  1317.     IF (NOT Quit) AND (Ch <> #0) AND (Ch <> #27) THEN BEGIN
  1318.       IF LocalKey THEN BEGIN
  1319.         IF Ch = ' ' THEN SText := '' ELSE SText := SText + Ch;
  1320.         sGotoXY(SysopX,SysopY); OutTxt(FG,0,Ch);
  1321.         INC(SysopX);
  1322.         IF SysopX = 79 THEN BEGIN
  1323.           IF SText <> '' THEN BEGIN
  1324.             sGotoXY(SysOpX - LENGTH(SText),SysOpY);
  1325.             sWrite(PadRight(' ',' ',LENGTH(SText)));
  1326.           END;
  1327.           SysopX := 2;
  1328.           INC(SysopY);
  1329.           IF SysopY > 10 THEN SysopY := 3;
  1330.           sGotoXY(SysopX,SysopY);
  1331.           sWrite(PadRight(' ',' ',77));
  1332.           IF SysopY < 10 THEN sGotoXY(SysopX,SysopY + 1) ELSE sGotoXY(SysopX,3);
  1333.           sWrite(PadRight(' ',' ',77));
  1334.           IF SText <> '' THEN BEGIN
  1335.             sGotoXY(SysopX,SysopY);
  1336.             IceText(SText,FALSE);
  1337.             INC(SysopX,LENGTH(SText));
  1338.           END;
  1339.         END;
  1340.         sGotoXY(SysopX,SysopY);
  1341.       END ELSE BEGIN
  1342.         IF Ch = ' ' THEN UText := '' ELSE UText := UText + Ch;
  1343.         sGotoXY(UserX,UserY); OutTxt(FG,0,Ch);
  1344.         INC(UserX);
  1345.         IF UserX = 79 THEN BEGIN
  1346.           IF UText <> '' THEN BEGIN
  1347.             sGotoXY(UserX - LENGTH(UText),UserY);
  1348.             sWrite(PadRight(' ',' ',LENGTH(UText)));
  1349.           END;
  1350.           UserX := 2;
  1351.           INC(UserY);
  1352.           IF UserY > 21 THEN UserY := 14;
  1353.           sGotoXY(UserX,UserY);
  1354.           sWrite(PadRight(' ',' ',77));
  1355.           IF UserY < 21 THEN sGotoXY(UserX,UserY + 1) ELSE sGotoXY(UserX,14);
  1356.           sWrite(PadRight(' ',' ',77));
  1357.           IF UText <> '' THEN BEGIN
  1358.             sGotoXY(UserX,UserY);
  1359.             IceText(UText,FALSE);
  1360.             INC(UserX,LENGTH(UText));
  1361.           END;
  1362.         END;
  1363.         sGotoXY(UserX,UserY);
  1364.       END;
  1365.     END;
  1366.   UNTIL Quit;
  1367.   DoorSys.UpdateSecs := TRUE;
  1368.   DoorSys.UpdateIdle := TRUE;
  1369.   Set_Color(7,0);
  1370.   sClrScr;
  1371.   PurgeInput;
  1372.   IceText('Press Any Key To Redraw Screen',FALSE);
  1373. END;
  1374. {───────────────────────────────────────────────────────────────────────────}
  1375. PROCEDURE LineChat;
  1376. CONST
  1377.   SysopText   : BYTE = 15;
  1378.   CallerText  : BYTE = 11;
  1379. VAR
  1380.   InputKey    : CHAR;
  1381.   Loop,I      : BYTE;
  1382.   CL,
  1383.   Temp,
  1384.   RTemp,
  1385.   Movement    : STRING;
  1386.   OldLocalKey : BOOLEAN;
  1387. BEGIN
  1388.   sClrScr;
  1389.   OutTxtL(15,0,Ctl.SFirst + ' ' + Ctl.SLast + ' Is Here At Your Services....');
  1390.   DoorSys.UpdateSecs := FALSE;
  1391.   DoorSys.UpdateIdle := FALSE;
  1392.   CL[0]       := #0;
  1393.   Movement[0] := #0;
  1394.   TextAttr    := SysopText;
  1395.   OldLocalKey := TRUE;
  1396.   WITH DoorSys DO REPEAT
  1397.     InputKey := sReadkey;
  1398.     IF LocalKey <> OldLocalKey THEN BEGIN
  1399.       IF LocalKey THEN TextAttr := SysopText ELSE TextAttr := CallerText;
  1400.       OldLocalKey := LocalKey;
  1401.     END;
  1402.     IF WrapLength <= BYTE(CL[0]) THEN BEGIN
  1403.       Temp[0]  := #0;
  1404.       RTemp[0] := #0;
  1405.       Loop     := BYTE(CL[0]);
  1406.       IF POS(#32,CL) <> 0 THEN WHILE (CL[Loop] <> #32) DO BEGIN
  1407.         sWrite(#8#32#8);
  1408.         Temp := Temp + CL[Loop];
  1409.         DEC(Loop);
  1410.       END ELSE WHILE (Loop >= WrapLength) DO BEGIN
  1411.         sWrite(#8#32#8);
  1412.         Temp := Temp + CL[Loop];
  1413.         DEC(Loop);
  1414.       END;
  1415.       IF Temp[0] <> #0 THEN FOR Loop := BYTE(Temp[0]) DOWNTO 1 DO RTemp := RTemp + Temp[Loop];
  1416.       sWrite(#13#10 + RTemp);
  1417.       CL := RTemp;
  1418.     END;
  1419.     IF (NOT (Inputkey IN [#13,#27,#8,#27,#0])) THEN BEGIN
  1420.       sWrite(InputKey);
  1421.       CL := CL + InputKey;
  1422.     END ELSE
  1423.     CASE InputKey OF
  1424.       #0  : Movement := s_ReadKey;
  1425.       #8  : IF CL <> '' THEN BEGIN
  1426.               sWrite(#8#32#8);
  1427.               DEC(CL[0]);
  1428.             END;
  1429.       #13 : BEGIN
  1430.               sWriteln('');
  1431.               CL := '';
  1432.             END;
  1433.       #27 : IF NOT LocalKey THEN Movement := InputKey + sReadKey + sReadKey;
  1434.     END;
  1435.     IF Movement <> '' THEN BEGIN
  1436.       FOR Loop := Tty TO Ansi DO BEGIN
  1437.         IF Movement = CursorMove.Up[Loop] THEN Movement := '' ELSE
  1438.         IF Movement = CursorMove.Down[Loop] THEN Movement := '' ELSE
  1439.         IF Movement = CursorMove.Left[Loop] THEN Movement := '' ELSE
  1440.         IF Movement = CursorMove.Right[Loop] THEN Movement := '' ELSE
  1441.         IF Movement = CursorMove.INSERT[Loop] THEN Movement := '' ELSE
  1442.         IF Movement = CursorMove.DELETE[Loop] THEN Movement := '' ELSE
  1443.         IF Movement = CursorMove.Home[Loop] THEN Movement := '' ELSE
  1444.         IF Movement = CursorMove.EndKey[Loop] THEN Movement := '';
  1445.       END;
  1446.       IF Movement <> '' THEN BEGIN
  1447.         FOR I := 1 TO LENGTH(Movement) DO sWrite(Movement[I]);
  1448.         Movement := '';
  1449.       END;
  1450.     END;
  1451.   UNTIL (LocalKey AND (InputKey = #27));
  1452.   DoorSys.UpdateSecs := TRUE;
  1453.   DoorSys.UpdateIdle := TRUE;
  1454.   Set_Color(7,0);
  1455.   sClrScr;
  1456.   PurgeInput;
  1457.   IceText('Press Any Key To Redraw Screen',FALSE);
  1458. END;
  1459. {───────────────────────────────────────────────────────────────────────────}
  1460. PROCEDURE ChatSelect;
  1461. BEGIN
  1462.   InChat := TRUE;
  1463.   IF (Graphics = RIP) OR (Graphics = MAX) THEN RipToText;
  1464.   Set_Color(7,0);
  1465.   IF Graphics = TTY THEN LineChat ELSE FullScreenChat;
  1466.   InChat := FALSE;
  1467. END;
  1468. {───────────────────────────────────────────────────────────────────────────}
  1469. PROCEDURE DVWrite(X,Y : WORD; Attr : BYTE; S : STRING); Assembler;
  1470. {X and Y are 1 based, not 0 zero based!}
  1471. Asm
  1472.   push ds
  1473.   mov bx,[y]
  1474.   DEC bx
  1475.   SHL bx,1
  1476.   mov ax,bx
  1477. {$ifopt G+}
  1478.   SHL bx,2
  1479. {$else}
  1480.   SHL bx,1
  1481.   SHL bx,1
  1482. {$endif}
  1483.   add ax,bx
  1484.   add ax,[DVseg]
  1485.   mov es,ax
  1486.   mov di,[x]
  1487.   DEC di
  1488.   SHL di,1
  1489.   add di,[DVofs]
  1490.   lds si,s
  1491.   mov cl,BYTE PTR [si]
  1492.   INC si
  1493.   mov ah,attr
  1494. @1 :
  1495.   mov al,BYTE PTR [si]
  1496.   mov WORD PTR es : [di],ax
  1497.   INC si
  1498.   add di,2
  1499.   DEC cl
  1500.   jnz @1
  1501.   pop ds
  1502. END;
  1503. {───────────────────────────────────────────────────────────────────────────}
  1504. PROCEDURE AlertTones;
  1505. VAR
  1506.   Loop : BYTE;
  1507. BEGIN
  1508.   FOR Loop := 1 TO 5 DO BEGIN
  1509.     IF NOT Local THEN SendStr(^G) ELSE WRITE(^G);
  1510.     DELAY(200);
  1511.   END
  1512. END;
  1513. {───────────────────────────────────────────────────────────────────────────}
  1514.  
  1515. END.
  1516.